%%% Copyright 2010 Google Inc.
%%%
%%% Licensed under the Apache License, Version 2.0 (the "License");
%%% you may not use this file except in compliance with the License.
%%% You may obtain a copy of the License at
%%%
%%%     http://www.apache.org/licenses/LICENSE-2.0
%%%
%%% Unless required by applicable law or agreed to in writing, software
%%% distributed under the License is distributed on an "AS IS" BASIS,
%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%%% See the License for the specific language governing permissions and
%%% limitations under the License.

%%% @copyright 2010 Google Inc. All Rights Reserved.
%%% @author <jacoby@google.com> Jacoby Thwaites [http://sites/madcloud]
%%% @version {@version}
%%% @doc
%%% Program database providing access to definitions of fields,
%%% operations and folders.
%%%
%%% A program and an operation are the same thing. Sometimes we say prog,
%%% sometimes we say op, sometimes we say prog/op. But it is true to say
%%% that a prog often won't have input or output sets defined on it (i.e.
%%% it's just a document with a root folder containing its definition).
%%%
%%% @headerfile "../include/txm.hrl"

-module(prog).

%%% Record definitions and constants.
-include("txm.hrl").

%%% XML schema definitions and constants.
-include("txml.hrl").

-compile(export_all).

%%% ---------------------------------------------------------------------------
%%% Exported functions
%%% ---------------------------------------------------------------------------

%%% Client functions that will always succeed return values directly.
-export([create_tables/0, init/0]).
-export([get_root_ref/0, record_to_ref/1]).
-export([delete_ref/2]).

%%% Client functions that might not succeed return ok or error tuples.
%%% This includes all functions that take a string path.
-export([get_root_ref/1, get_root_ref/2]).
-export([resolve_absolute/1, resolve_relative/2, resolve_scoped/2]).
-export([get_record/1]).

-export([new_record/3]).
-export([snapshot/1, snapshot/2]).

-export([get_shallow_index/1, get_deep_index/1]).
-export([get_shallow_contents/1, get_deep_contents/1]).

-export([import_file/2, import_binary/2]).

%%% ---------------------------------------------------------------------------
%%% Initialization functions
%%% ---------------------------------------------------------------------------

%% @doc Call this once to create the schema and tables. Also creates the root
%% folder under which all other entries exist.
%% @spec create_tables() -> ok
create_tables() ->
  mnesia:stop(),
  {create_schema, ?OK_RETURN} =
    {create_schema, mnesia:create_schema([node()])},
  mnesia:start(),
  ?INFO([create_table, {mnesia, ?FOLDER}]),
  mnesia:create_table(?FOLDER, [{disc_copies, [node()]},
                                {attributes, record_info(fields, ?FOLDER)}]),
  ?INFO([create_table, {mnesia, ?FIELD}]),
  mnesia:create_table(?FIELD, [{disc_copies, [node()]},
                               {attributes, record_info(fields, ?FIELD)}]),
  ?INFO([create_table, {mnesia, ?OP}]),
  mnesia:create_table(?OP, [{disc_copies, [node()]},
                            {attributes, record_info(fields, ?OP)}]),
  mnesia:wait_for_tables(?TABLES, ?OPEN_TIMEOUT),
  create_root_folder(),
  ?OK_RETURN.

%% @doc Copies the tables from the current node to the specified node.
copy_tables(Node) ->
  mnesia:change_config(extra_db_nodes, [Node]),
  F = fun(Table) ->
           mnesia:add_table_copy(Table, Node, ram_copies),
           Table
      end,
  [{copied, F(Table)} || Table <- ?TABLES].

%%% ---------------------------------------------------------------------------
%%% Public functions
%%% ---------------------------------------------------------------------------

%% @doc Must be called once per node. Starts mnesia and returns when
%% ready for calls.
%% @spec init() -> ok | {error, Reason}
init() ->
  mnesia:start(),
  ?INFO([waiting, {mnesia, ?TABLES}, {timeout, ?OPEN_TIMEOUT}]),
  case mnesia:wait_for_tables(?TABLES, ?OPEN_TIMEOUT) of
    ?OK_RETURN -> ?OK_RETURN;
    {timeout, Missing} -> ?ERROR_RETURN(Missing)
  end.

%% @doc Returns the reference of the root folder of the whole tree.
%% @spec get_root_ref() -> ref()
get_root_ref() -> ?OK_RETURN(?ROOT_FOLDER_REF).

%% @doc Returns the reference of the root folder of the specified composite
%% prog/op, or error if the op is non-composite or the spec invalid.
%% @spec get_root_ref(ref()) -> {ok, ref()} | {error, reason()}
get_root_ref(OpRef) ->
  do_fun(fun() -> get_root_ref_(OpRef) end).

%% @doc Returns the versioned root folder reference of the specified composite
%% prog/op, or error if the op is non-composite or the spec invalid.
%% @spec get_root_ref(ref(), versionRef()) ->
%%          {ok, ref()}
%%        | {error, reason()}
get_root_ref(OpRef, Version) ->
  do_fun(fun() -> get_root_ref_(OpRef, Version) end).

%% @doc Creates a new field, folder or operation in the specified folder
%% using the supplied name.
%%
%% Returns the newly created record, including id. In the case of
%% an op record whose `isComposite` field is `true`, creates a root
%% folder and includes the reference in the `rootFolderRef' field.
%% @spec new_record(ref(), string(), rec())
%%          -> {ok, rec()} | {error, reason()}
new_record(FolderRef, Name, Record) when is_list(Name) ->
  do_fun(fun() -> new_record_(FolderRef, Name, Record) end).

%% @doc Returns the reference corresponding to the supplied absolute path.
%% @spec resolve_absolute(string()) -> {ok, ref()} | {error, reason()}
resolve_absolute("/" ++ Path) ->
  resolve_relative(?ROOT_FOLDER_REF, Path).

%% @doc Returns the reference corresponding to the supplied `Path' relative
%% to the `RootRef'.
%% @spec resolve_relative(ref(), string()) -> {ok, ref()} | {error, reason()}
resolve_relative(_SomeRef, "/" ++ Path) ->
  resolve_relative(?ROOT_FOLDER_REF, Path);

%% #2
resolve_relative(FolderRef, Path) ->
      do_fun(fun() -> resolve_relative_(FolderRef, Path) end).

%% @doc Returns the reference corresponding to the supplied `Name' in the
%% folder `FolderRef'. The reference against the name in the supplied folder
%% or the first ancestor folder is returned, or error if not found.
%% @spec resolve_scoped(ref(), string()) -> {ok, ref()} | {error, reason()}
resolve_scoped(FolderRef, Name) ->
  do_fun(fun() -> resolve_scoped_(FolderRef, Name) end).

%% @doc Deletes the reference corresponding to `Path'. This does not delete
%% a record, which may be referenced by another folder. But the name is
%% removed from the containing folder.
%% @spec delete_ref(ref(), string()) -> ok | {error, reason()}
delete_ref(FolderRef, Path) ->
  do_fun(fun() -> delete_ref_(FolderRef, Path) end).

%% @doc Returns the record specified by the supplied path or reference.
%% @spec get_record(ref()) -> {ok, rec()} | {error, reason()}
get_record(Ref) ->
  do_fun(fun() -> get_record_(Ref) end).

%% @doc Returns the index struct for the supplied `FolderSpec'.
%% @spec get_shallow_index(ref()) -> struct()
get_shallow_index(FolderRef) ->
  try
    ?OK_RETURN(do_fun(fun() -> get_shallow_index_(FolderRef) end))
  catch
    _Fault:Reason ->
      ?ERROR_RETURN(Reason)
  end.

%% @doc Returns the nested index struct for the supplied `FolderSpec'.
%% @spec get_deep_index(ref()) -> struct()
get_deep_index(FolderRef) ->
  try
    ?OK_RETURN(do_fun(fun() -> get_deep_index_(FolderRef) end))
  catch
    _Fault:Reason ->
      ?ERROR_RETURN(Reason)
  end.

%% @doc Returns the list of records in the supplied `FolderSpec'.
%% @spec get_shallow_contents(ref()) -> {ok, list(rec())} | {error, reason()}
get_shallow_contents(Ref) ->
  try
    ?OK_RETURN(do_fun(fun() -> get_shallow_contents_(Ref) end))
  catch
    _Fault:Reason ->
      ?ERROR_RETURN(Reason)
  end.

%% @doc Returns the list of records in the supplied `FolderSpec' and its
%% descendant folders.
%% This does not recurse through composite ops.
%% @spec get_deep_contents(ref()) -> list(rec())
get_deep_contents(Ref) ->
  try
    ?OK_RETURN(
      do_fun(fun() -> get_deep_contents_(Ref) end))
  catch
    _Fault:Reason ->
      ?ERROR_RETURN(Reason)
  end.

%% @doc Creates new version of the op, numbered but unnamed.
%% @see snapshot/2
%% @spec snapshot(ref()) -> {ok, op()}
snapshot(OpRef) ->
  do_fun(fun() -> snapshot_(OpRef, []) end).

%% @doc Creates a new version of the prog/op, numbered and named.
%% This works by creating a deep copy of the root folder of the specified
%% prog/op up to and including sub-operations (complete with their own
%% root/versions but we don't copy those). Places a reference to the copy in
%% the versions dict of the specified prog/op with the supplied version name,
%% and returns said prog/op.
%% @spec snapshot(ref(), string()) -> {ok, op()}
snapshot(OpRef, NewVsnName) ->
  do_fun(fun() -> snapshot_(OpRef, NewVsnName) end).

%% @doc Reads an XML file, creating the contents at the specified `root'
%% in a single transaction which fails if any part of the file is incorrect.
%% @spec import_file(ref(), string()) -> ok
import_file(Root, Filename) ->
  do_fun(fun() -> import_file_(Root, Filename) end).

%% @doc Processes a binary containing XML, creating the contents at the
%% specified `root' folder in a single transaction which fails if any part
%% of the binary is incorrect.
%% @spec import_binary(ref(), binary()) -> ok
import_binary(Root, Binary) ->
  do_fun(fun() -> import_binary_(Root, Binary) end).

%%% ---------------------------------------------------------------------------
%%% Private functions
%%% ---------------------------------------------------------------------------

%% For the time being, the {mega, secs, micro} tuple will do nicely for
%% unique ids.
gen_id() ->
  now().

%% Creates the root folder in the database. All other entries exist under
%% this entry. Returns the root folder id.
create_root_folder() ->
  F = fun() ->
           Root = #?FOLDER{id = ?ROOT_FOLDER_ID},
           mnesia:write(Root),
           ?ROOT_FOLDER_ID
      end,
  do_fun(F).

%% Executes the supplied function within a transaction and returns the result.
do_fun(F) ->
  {atomic, Result} = mnesia:transaction(F),
  Result.

%% @doc Compute the type of the operation implied by the supplied input
%% and output sets, and returns a new op with the set fields populated:
%% <ul>
%% <li>`n' - Notification = output only, and no input.</li>
%% <li>`oo' - One-way = input only, and no output.</li>
%% <li>`rr'- Request/Reply = non-intersecting input and output</li>
%% <li>`irr' - Iterative Request/Reply = intersecting input/output</li>
%% <li>`null' - Null = no input or output</li>
%% </ul>
%% @spec op_type(nr_set(), nr_set_dict()) -> n | oo | rr | irr
op_type(Input, Outputs) ->

  % Infer operation type from set sizes and intersection.
  InputSet = nr_set:ref_set(Input),
  OutputUnion = nr_set_dict:ref_union_set(Outputs),
  case {sets:size(InputSet), sets:size(OutputUnion),
        sets:is_disjoint(InputSet, OutputUnion)} of
    {0, 0, _} -> ?OP_TYPE_NULL;
    {0, _, _} -> ?OP_TYPE_N;
    {_, 0, _} -> ?OP_TYPE_OO;
    {_, _, true} -> ?OP_TYPE_RR;
    {_, _, false} -> ?OP_TYPE_IRR
  end.

%% @doc Returns the reference associated with the supplied record.
%% @spec record_to_ref(rec()) -> ref()
record_to_ref(#?FIELD{id = Id}) -> {?FIELD, Id};
record_to_ref(#?FOLDER{id = Id}) -> {?FOLDER, Id};
record_to_ref(#?OP{id = Id}) -> {?OP, Id}.

%% Adds the supplied Name, Ref to the folder entries.
%% @spec add_entry(string(), ref(), folder()) -> folder()
add_entry(Name, Ref, #?FOLDER{entries = Entries} = Folder) ->
  NewEntries = nr_set:store({Name, Ref}, Entries),
  Folder#?FOLDER{entries = NewEntries}.

%%% ---------------------------------------------------------------------------
%%% Functions (ending in _) suitable for composition.
%%% These functions do Mnesia operations without a transaction, so will
%%% throw an exception unless wrapped in composite functions.
%%% ---------------------------------------------------------------------------

%% Creates a new record in the specified folder and updates tables.
%% Returns a copy of the new record with id and other fields populated.
%% @spec new_record_(recspec(), name(), rec()) -> rec()
new_record_(ParentRef, Name, Rec) ->
  ?OK_RETURN(Parent) = get_record_(ParentRef),
  {NewRef, NewRec} = new_record_(Rec, ParentRef),
  UpdatedParent = add_entry(Name, NewRef, Parent),
  ?OK_RETURN(SavedRec) = put_record_(NewRec),
  rpl_record_(Parent, UpdatedParent),
  ?OK_RETURN(SavedRec).

%% Returns the {Ref, Rec} tuple with `id' field populated against the supplied
%% field, folder or operation record.
%% @spec new_record_(rec(), ref()) -> {ref(), rec()}
new_record_(#?FIELD{} = Field, _ParentRef) ->
  NewField = Field#?FIELD{id = gen_id()},
  {record_to_ref(NewField), NewField};

%% #2
%% A new folder has an automatic '..' entry pointing to the
%% original parent.
new_record_(#?FOLDER{entries = Entries} = Folder, ParentRef) ->
  NewFolder =
    Folder#?FOLDER{
           id = gen_id(),
           entries = nr_set:store({?PARENT_FOLDER_NAME, ParentRef}, Entries)},
  {record_to_ref(NewFolder), NewFolder};

%% #3
%% A new composite op requires a root folder to be written with parent
%% pointing back to the op's parent folder.
%% Browsing down the tree, you see the op and select its root folder to carry
%% on down. Coming back up, the .. entry in the root folder bypasses the op.
%% The point of this is:
%% a) to allow the tree to be partitioned at any op across clusters.
%% b) to allow distinct versions of the op root to be selected on the way down.
new_record_(#?OP{isComposite = IsComposite,
                 rootFolderRef = SuppliedRef,
                 input = Input,
                 outputs = Outputs} = Op, ParentRef) ->

    % Construct the op record. If composite and no root folder is set, then
    % create and set the root folder as well.
    case {IsComposite, SuppliedRef} of
        {true, ?NULL_REF} ->
            {RootRef, RootRec} = new_record_(#?FOLDER{}, ParentRef),
            put_record_(RootRec),
            NewOp = Op#?OP{id = gen_id(),
                           opType = op_type(Input, Outputs),
                           rootFolderRef = RootRef};
        _Otherwise ->
            NewOp = Op#?OP{id = gen_id(),
                           opType = op_type(Input, Outputs)}
    end,
    {record_to_ref(NewOp), NewOp}.

%% @doc Takes the values in `Dict' and returns a set of those values.
%% @spec make_set(dict()) -> set()
make_set(Dict) ->
  dict:fold(fun(_Name, Ref, Set) ->
                 sets:add_element(Ref, Set)
            end,
            sets:new(), Dict).

%% Saves the record.
%% @spec put_record_(rec()) -> {ok, rec()}
put_record_(Record) ->
  mnesia:write(Record),
  ?OK_RETURN(Record).

%% Deletes the record with the specified key in the specified table.
%% @spec del_record_(ref()) -> ok
del_record_(Ref) ->
  mnesia:delete(Ref).

%% Replaces the old record with the new record, ensuring that the
%% old and new are the same type and id while we're at it.
%% @spec rpl_record_(rec(), rec()) -> rec()
rpl_record_(Old, New) ->
  Ref = record_to_ref(Old),
  Ref = record_to_ref(New),
  del_record_(Ref),
  put_record_(New).

%% Returns the reference corresponding to `PathName' relative to the
%% folder specified by `RootRef'. Any leading `/' in the path is
%% ignored, it is always a relative path.
%% @spec resolve_relative_(ref(), path()) -> {ok, ref()} | {error, reason()}
resolve_relative_(RootRef, PathName) ->
  Steps = string:tokens(PathName, ?PATH_SEPARATOR),
  steps_to_ref_(RootRef, Steps).

%% @doc Resolves the supplied pathlist to a ref, starting at the folder `Ref'.
%% @spec steps_to_ref_(ref(), list(string())) -> {ok, ref()} | {error, reason()}
steps_to_ref_(Ref, []) ->
  ?OK_RETURN(Ref);

%% #2
steps_to_ref_({?FOLDER, _} = FolderRef, [Step|Steps]) ->
  case {parent, get_record_(FolderRef)} of
    {parent, ?OK_RETURN(#?FOLDER{entries = Entries})} ->
      case {entry, nr_set:ref_for_name(Step, Entries)} of
        {entry, ?NOT_FOUND} ->
          ?ERROR_RETURN(?REASON_NOT_FOUND);
        {entry, NextRef} ->
          steps_to_ref_(NextRef, Steps)
      end;
    {parent, Error} -> Error
  end.

%% Returns the reference against `Name' in the supplied folder or the
%% first ancestor folder containing `Name'.
%% @spec resolve_scoped_(ref(), name()) -> {ok, ref()} | {error, reason()}
resolve_scoped_(FolderRef, Name) ->
  ?OK_RETURN(#?FOLDER{entries = Entries}) = get_record_(FolderRef),
  case nr_set:ref_for_name(Name, Entries) of
    ?NOT_FOUND ->
      case nr_set:ref_for_name(?PARENT_FOLDER_NAME, Entries) of
        ?NOT_FOUND ->
          ?ERROR_RETURN(?REASON_NOT_FOUND);
        ParentRef ->
          resolve_scoped_(ParentRef, Name)
        end;
    Ref -> ?OK_RETURN(Ref)
  end.

%% Deletes the reference corresponding to the name in `PathName' as resolved
%% from the folder `RootRef'.
%% @spec delete_ref_(ref(), string()) -> #folder{}
delete_ref_(RootRef, PathName) ->
  Names = string:tokens(PathName, ?PATH_SEPARATOR),
  {Path, Name} = detach_last_(Names, []),
  ?OK_RETURN(FolderRef) = resolve_relative_(RootRef, Path),
  ?OK_RETURN(#?FOLDER{entries = Entries} = OldFolder) =
    get_record_(FolderRef),
  NewFolder =
    OldFolder#?FOLDER{entries = nr_set:delete_by_name(Name, Entries)},
  rpl_record_(OldFolder, NewFolder),
  ?OK_RETURN.

%% Detaches the last element of a list (e.g. the name in a pathname).
%% @spec detach_last_(list(), list()) -> {list(), term()}
detach_last_([Last], Acc) -> {lists:reverse(Acc), Last};
detach_last_([Step | Rest], Acc) ->
  detach_last_(Rest, [Step | Acc]).

%% Returns the mutable root folder of the specified prog/op.
%% @spec get_root_ref_(ref()) -> {ok, ref()} | {error, reason()}
get_root_ref_(OpRef) ->
  case get_record_(OpRef) of
    ?OK_RETURN(#?OP{rootFolderRef = RootFolder}) ->
      ?OK_RETURN(RootFolder);
    Error -> Error
  end.

%% 1st clause matches composite op records with at least one version.
%% Returns the versioned root folder of the supplied op record.
%% @spec get_root_ref_(rec(), versionref()) -> {ok, ref()}
get_root_ref_(#?OP{isComposite = true,
                   versions = [Latest|_] = Versions}, VsnRef) ->
  % Get the specified version tuple.
  Version =
    case VsnRef of
      ?VERSION_LATEST -> Latest;
      ?VERSION_DYNAMIC -> Latest;
      VsnRef when is_number(VsnRef) -> lists:keyfind(VsnRef, 1, Versions);
      VsnRef when is_list(VsnRef) -> lists:keyfind(VsnRef, 2, Versions)
    end,

  case Version of
    {_Number, _Label, FolderRef} -> ?OK_RETURN(FolderRef);
    _NotInVersions -> ?ERROR_RETURN(?REASON_NO_VERSION)
  end;

%% 2nd clause matches composite op records with no versions yet created.
get_root_ref_(#?OP{isComposite = true,
                  versions = []}, _Version) ->
  ?ERROR_RETURN(?REASON_NO_VERSION);

%% 3rd clause matches op specs that need to be resolved to the record.
%% Returns the versioned root folder of the specified prog/op.
%% @spec get_root_ref_(recspec(), versionref()) ->
%%            {ok, ref()} | {error, reason()}
get_root_ref_(OpSpec, Version) ->
  case get_record_(OpSpec) of
    ?OK_RETURN(Op) -> get_root_ref_(Op, Version);
    Error -> Error
  end.

%% Returns the record matching the supplied reference, or error if not found.
%% @spec get_record_(ref()) -> {ok, rec()}
%%                           | {error, reason()}
get_record_({Table, Id}) ->
  case mnesia:read(Table, Id) of
    [Record] -> ?OK_RETURN(Record);
    [] -> ?ERROR_RETURN(?REASON_NOT_FOUND)
  end.

%% @doc Returns a shallow index struct on the specified folder reference.
%% The shallow index includes the parent folder reference.
%% @spec get_shallow_index_(ref()) -> struct()
get_shallow_index_({?FOLDER, Id} = FolderRef) ->
  ?OK_RETURN(#?FOLDER{entries = Entries}) = get_record_(FolderRef),
  {index, [{id, Id}], nr_set:fold(
     fun(EntryName, {EntryTag, EntryId}, Acc) ->
          [{EntryTag, [{name, EntryName}, {id, EntryId}]} | Acc]
     end, [], Entries)}.

%% @doc Returns a deep index struct on the specified folder reference.
%% The deep index excludes all parent folder references.
%% @spec get_deep_index_(ref()) -> struct()
get_deep_index_(FolderRef) ->
  deep_index_("", FolderRef).

deep_index_(Name, {?FOLDER, FolderId} = FolderRef) ->
  ?OK_RETURN(#?FOLDER{entries = Entries}) = get_record_(FolderRef),
  {index,
   [{name, Name}, {id, FolderId}],
   nr_set:fold(fun(EntryName, Ref, Acc) ->
                    case {EntryName, Ref} of
                      {"..", {?FOLDER, _ParentId}} ->
                        Acc;
                      {EntryName, {?FOLDER, Id}} ->
                        [deep_index_(EntryName, {?FOLDER, Id}) | Acc];
                      {EntryName, {NonFolder, Id}} ->
                        [{NonFolder, [{name, EntryName}, {id, Id}]} | Acc]
                      end
               end, [], Entries)}.

%% @doc Returns the contents of the specified folder, without including
%% children folders and without recursing into children folders.
%% @spec get_shallow_contents_(ref()) -> list(rec())
get_shallow_contents_(FolderRef) ->
  ?OK_RETURN(#?FOLDER{entries = Entries}) =
    get_record_(FolderRef),
  nr_set:fold(
    fun(_Name, Ref, Acc) ->
         case Ref of
           {?FOLDER, _Id} ->
             Acc;
           {_Other, _Id} ->
             ?OK_RETURN(Record) = get_record_(Ref),
             [Record | Acc]
           end
    end,
    [], Entries).

%% @doc Returns the contents of the specified folder and all descendant
%% folders. The descendant folders themselves are not included in the
%% list of returned records, although their non-folder contents are.
%% This only recurses through folders, not into composite ops.
%% @spec get_deep_contents_(ref()) -> list(rec())
get_deep_contents_(FolderRef) ->
  deep_contents_(FolderRef, []).

deep_contents_(FolderRef, InitialAcc) ->
  ?OK_RETURN(#?FOLDER{entries = Entries}) = get_record_(FolderRef),
  nr_set:fold(fun(EntryName, Ref, Acc) ->
                   case {EntryName, Ref} of
                     {"..", {?FOLDER, _ParentId}} ->
                       Acc;
                     {_FolderName, {?FOLDER, _FolderId}} ->
                       deep_contents_(Ref, Acc);
                     {_Name, NonFolderRef} ->
                       ?OK_RETURN(Rec) = get_record_(NonFolderRef),
                       [Rec | Acc]
                     end
              end, InitialAcc, Entries).

%% Writes a snapshot of the specified op root folder and subfolders, and writes
%% an updated version of the specified op to include the new version.
%%
%% If the spec does not resolve to an operation, or the operation is not
%% composite, returns an error. Otherwise, returns the modified record.
%% @spec snapshot_(ref(), name()) ->
%%          {ok, op()}
%%        | {error, not_found | wrong_kind}
snapshot_(OpRef, NewVsnName) ->
  case {op, get_record_(OpRef)} of
    {op, ?OK_RETURN(#?OP{isComposite = true} = Op)} ->
      snapshot1_(Op, NewVsnName);
    {op, ?OK_RETURN(#?OP{isComposite = false})} ->
      ?ERROR_RETURN(?REASON_WRONG_KIND);
    {op, Error} -> Error
  end.

%% Writes a deep copy of the root folder and subfolders in the supplied
%% composite prog/op. Updates the `versions' field of the op and replaces the
%% original record with the updated one.
%% @spec snapshot1_(op(), name()) -> op()
snapshot1_(#?OP{rootFolderRef = RootRef,
                versions = Versions} = Op,
           NewVsnName) ->
  NewVersionRef = new_deep_copy_(?ROOT_FOLDER_NAME, RootRef),
  NewVersions = add_version(NewVsnName, NewVersionRef, Versions),
  NewOp = Op#?OP{versions = NewVersions},
  rpl_record_(Op, NewOp),
  ?OK_RETURN(NewOp).

%% Adds a numbered version to `Versions' using `Name' and `Ref'.
%% @spec add_version(string(), ref(), list()) -> list()
add_version(Name, Ref, []) ->
    [{1, Name, Ref}];
add_version(Name, Ref, [{LastVsn, _LastName, _LastRef} | _Rest] = Versions) ->
    [{LastVsn + 1, Name, Ref} | Versions].

%% Recurses through the folder tree starting at the supplied entry. Writes
%% a new copy of each folder record and updates the parent folder's entries
%% accordingly. We don't recurse up the parent folders, obviously :)
%%
%% Trick to understanding this is, that the function passed to
%% nr_set:map/2 takes 2 args (key, value) but only returns 1 (newvalue).
%% @spec new_deep_copy_(string(), ref()) -> {string(), ref()}
new_deep_copy_(Name, {?FOLDER, ?ID_PTN} = Ref)
  when Name =/= ?PARENT_FOLDER_NAME ->
  ?OK_RETURN(#?FOLDER{entries = ChildEntries}) =
    ?OK_RETURN(Folder) = get_record_(Ref),
  NewEntries = nr_set:map(fun new_deep_copy_/2, ChildEntries),
  NewFolder = Folder#?FOLDER{id = gen_id(), entries = NewEntries},
  put_record_(NewFolder),
  record_to_ref(NewFolder);

new_deep_copy_(_Name, NonChildFolder) -> NonChildFolder.

%%% ---------------------------------------------------------------------------
%%% XML import functions
%%% ---------------------------------------------------------------------------

%% Imports `Filename` which contains XML and places the created contents
%% under `Root`. This must be called inside an open transaction.
%% @spec import_file_(ref(), string()) -> ok
import_file_(Root, Filename) when is_list(Filename) ->
  ?INFO([import_file, {root, Root}, {file, Filename}]),
  ?OK_RETURN(#?FOLDER{} = Folder) = get_record_(Root),

  % Start callbacks with entity representing `Root'.
  xmerl_sax_parser:file(Filename, [{event_fun, fun event_/3},
                   {event_state, [{"", Folder}]}]),
  ?OK_RETURN.

%% Imports `Binary` which contains XML and places the created contents
%% under `Root`. This must be called inside an open transaction. `Binary'
%% can be unicode_binary() | latin1_binary() | [unicode_char()]
%% @spec import_binary_(ref(), binary()) -> ok
import_binary_(Root, Binary) when is_binary(Binary)
                                    orelse is_list(Binary) ->
  ?INFO([import, {root, Root}]),
  ?OK_RETURN(#?FOLDER{} = Folder) = get_record_(Root),

  % Start callbacks with entity representing `Root'.
  xmerl_sax_parser:stream(Binary, [{event_fun, fun event_/3},
                                   {event_state, [{"", Folder}]}]),
  ?OK_RETURN.

%% ---------------------------------------------------------------------------
%% SAX callbacks.
%% The returned state from each event_ function is a stack of `entity()'
%% types, the topmost item being that under construction. Each entity is
%% a {name :: string(), record :: rec()}
%% ---------------------------------------------------------------------------
%% <op name="...">
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_OP,
             attributes = Attrs}, _Location, Stack) ->
  ?DEBUG([{?ELEMENT_OP, Attrs}]),
  ?OK_RETURN(Name) = attribute_value(?ATTR_NAME, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),
  {_Ref, Op} = new_record_(#?OP{}, Parent),
  [{Name, Op} | Stack];

%% Write op and pop stack on end element.
event_(#?END_ELEMENT{uri = ?TXML_NS,
           lname = ?ELEMENT_OP}, _Location,
     [{Name, Op} | Stack]) ->
  Parent = containing_folder(Stack),
  ?OK_RETURN(_Rec) = new_record_(Parent, Name, Op),
  Stack;

%% ---------------------------------------------------------------------------
%% <mask fields="...">
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_MASK,
             attributes = Attrs}, _Location,
     [{Name, Op} | Stack]) ->
  ?OK_RETURN(Fields) = attribute_value(?ATTR_FIELDS, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),
  Proplist = [{Field, ?OK_RESULT(resolve_scoped_(Parent, Field))}
        || Field <- string:tokens(Fields, ?NAME_SEPARATOR)],
  [{Name, Op#?OP{mask = nr_set:from_proplist(Proplist)}} | Stack];

%% ---------------------------------------------------------------------------
%% <input fields="...">
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_INPUT,
             attributes = Attrs}, _Location,
     [{Name, Op} | Stack]) ->
  ?OK_RETURN(Fields) = attribute_value(?ATTR_FIELDS, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),
  Proplist = [{Field, ?OK_RESULT(resolve_scoped_(Parent, Field))}
        || Field <- string:tokens(Fields, ?NAME_SEPARATOR)],
  [{Name, Op#?OP{input = nr_set:from_proplist(Proplist)}} | Stack];

%% ---------------------------------------------------------------------------
%% <output name="..." fields="...">
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_OUTPUT,
             attributes = Attrs}, _Location, [{Name, Op} | Stack]) ->
  ?OK_RETURN(Fields) = attribute_value(?ATTR_FIELDS, Attrs, ?ATTR_NO_DEFAULT),
  ?OK_RETURN(SetName) = attribute_value(?ATTR_NAME, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),
  Proplist = [{Field, ?OK_RESULT(resolve_scoped_(Parent, Field))}
         || Field <- string:tokens(Fields, ?NAME_SEPARATOR)],
  NrSet = nr_set:from_proplist(Proplist),
  Outputs = nr_set_dict:store_nr_set(SetName, NrSet, Op#?OP.outputs),
  [{Name, Op#?OP{outputs = Outputs}} | Stack];

%% ---------------------------------------------------------------------------
%% <folder name="..."> under <op/> is compositional. Name attribute is
%% optional and used as version name if present.
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
                       lname = ?ELEMENT_FOLDER,
                       attributes = Attrs}, _Location,
       [{OpName, #?OP{versions = Versions} = Op} | Stack]) ->

    ?DEBUG([compositional, {?ELEMENT_FOLDER, Attrs}]),
    
    %% An empty or missing name attribute means this is the root folder.
    %% A specified name attribute means this is a versioned folder.
    ?OK_RETURN(Name) = attribute_value(?ATTR_NAME, Attrs, ""),
    Parent = containing_folder(Stack),

    %% Create the new folder and write it directly, unlinked to a parent.
    {Ref, Folder} = new_record_(#?FOLDER{}, Parent),
    ?OK_RETURN(Folder) = put_record_(Folder),
    NewOp =
        case Name of
            ?EMPTY_STRING ->
                Op#?OP{isComposite = true,
                       rootFolderRef = Ref};
            Name ->
                Op#?OP{isComposite = true,
                       versions = add_version(Name, Ref, Versions)}
        end,

    %% Returned stack has folder then revised op.
    [{Name, Folder}, {OpName, NewOp} | Stack];

%% ---------------------------------------------------------------------------
%% <folder name="..."> is otherwise not compositional.
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_FOLDER,
             attributes = Attrs}, _Location, Stack) ->

  ?DEBUG([{?ELEMENT_FOLDER, Attrs}]),
  ?OK_RETURN(Name) = attribute_value(?ATTR_NAME, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),

  % Folder record is written immediately.
  ?OK_RETURN(Folder) = new_record_(Parent, Name, #?FOLDER{}),
  [{Name, Folder} | Stack];

%% Pop folder entity on end tag.
event_(#?END_ELEMENT{uri = ?TXML_NS,
           lname = ?ELEMENT_FOLDER}, _Location, [_Folder | Stack]) ->
  Stack;

%% ---------------------------------------------------------------------------
%% <field name="..." type="...">
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_FIELD,
             attributes = Attrs}, _Location, Stack) ->
  ?DEBUG([{?ELEMENT_FIELD, Attrs}]),
  ?OK_RETURN(Name) = attribute_value(?ATTR_NAME, Attrs, ?ATTR_NO_DEFAULT),
  ?OK_RETURN(Type) = attribute_value(?ATTR_TYPE, Attrs, ?ATTR_NO_DEFAULT),
  Parent = containing_folder(Stack),
  ?OK_RETURN(_Field) = new_record_(Parent, Name, #?FIELD{type = Type}),
  Stack;

%% ---------------------------------------------------------------------------
%% <list> simply encloses stuff that's to be placed in the current folder.
%% It's only used when an XML file has >1 field, folder or op to be placed
%% in the current folder, rather than in a sub-folder.
%% ---------------------------------------------------------------------------
event_(#?START_ELEMENT{uri = ?TXML_NS,
             lname = ?ELEMENT_LIST}, _Location, Stack) ->
  ?DEBUG([{?ELEMENT_LIST, Attrs}]),
  Stack;

%% ---------------------------------------------------------------------------
%% Ignored callbacks, *including* endElement events not specifically
%% handled above.
%% ---------------------------------------------------------------------------
event_(Event, _Location, Stack) when
  Event == ?START_DOCUMENT orelse
    Event == ?END_DOCUMENT orelse
    is_record(Event, ?COMMENT) orelse
    is_record(Event, ?IGNORABLE_WHITESPACE) orelse
    is_record(Event, ?START_PREFIX_MAPPING) orelse
    is_record(Event, ?END_PREFIX_MAPPING) orelse
    is_record(Event, ?END_ELEMENT) ->
  Stack;

%% All other events are a bit of a surprise. This includes start tags we don't
%% recognize.
event_(Event, Location, Stack) ->
  ?WARNING([{event, Event},
        {location, Location}]),
  Stack.

%% Returns the value of the named attribute, or the supplied `Default`.
%% @spec attribute_value(string(), list(), string()) ->
%%         {ok, string()} | {error, reason()}
attribute_value(_Name, [], ?ATTR_NO_DEFAULT) ->
  ?ERROR_RETURN(?REASON_NOT_FOUND);
attribute_value(_Name, [], Default) ->
  ?OK_RETURN(Default);
attribute_value(Name, [{[], [], Name, Value} | _Rest], _Default) ->
  ?OK_RETURN(Value);
attribute_value(Name, [_First | Rest], Default) ->
  attribute_value(Name, Rest, Default).

%% Returns the reference of the first folder entity in `Stack'.
containing_folder([{_Name, #?FOLDER{} = Folder} | _Rest]) ->
  record_to_ref(Folder);
containing_folder([_NonFolderEntity | Rest]) ->
  containing_folder(Rest).
